Excel Vba快速界面设计入门 |
您所在的位置：网站首页 › 编辑vba代码时使用的界面是 ( ) › Excel Vba快速界面设计入门 |
Excel Vba快速界面设计入门
|
一、打开 开发工具->Visual Basic ，进入代码编辑区。 二、双击 ThisWorkbook ，从右侧上部选择 打开事件，并输入代码。 三、从 插入->用户窗口，会插入界面，左侧会出现UserForm1，根据相关功能插入对应控件并修改属性（同VB)。 四、双击控件，进入对应控件的代码输入。 以选择目录对2003版excel改为2007版本excel为例： （其中，用的dir递归循环查找，由于涉及递归中混淆dir默认目录，所以递归中的目录必须进入数组，这样才能调用深层递归） Private Sub btnBrowser_Click() Dim fd As FileDialog Dim strPath As String Set fd = Application.FileDialog(msoFileDialogFolderPicker) If fd.Show = -1 Then '选择了文件夹 strPath = fd.SelectedItems(1) Else strPath = "" End If txtPath.Text = strPath Set fd = Nothing End Sub Private Sub btnSearch_Click() If txtPath.Text = "" Then MsgBox ("请选择文件夹后操作！！！") Exit Sub End If Dim strPath As String If Right(txtPath.Text, 1) "\" Then '盘符文件夹时多了一个\,统一规格 strPath = txtPath.Text & "\" End If SearchFile (strPath) lblState.Caption = "查找完成！！！" End Sub Private Sub SearchFile(strPath As String) Dim strFile As String, strFolder As String, n As Long, i As Long Dim strHead As String, strEnd As String, a() As String strFile = Dir(strPath) Do While strFile "" lblState.Caption = strPath & strFile strEnd = Right(strFile, Len(strFile) - InStrRev(strFile, ".")) '尾部，后缀名 If strEnd = "xls" Then strHead = Left(strFile, InStrRev(strFile, ".") - 1) '头部 Set objFS = CreateObject("Scripting.FileSystemObject") '文件系统检查 If objFS.fileExists(strPath & strHead & ".xlsx") = False Then '不存在，转换 Dim wb As Workbook Set wb = Application.Workbooks.Open(strPath & strFile) wb.SaveAs (strPath & strHead & ".xlsx") wb.Close Set wb = Nothing Kill strPath & strHead & ".xls" Else '有了，两文件同时存在 lstFile.AddItem strPath & strFile End If End If strFile = Dir '继续向下查找 DoEvents Loop strFolder = Dir(strPath, vbDirectory) Do While strFolder "" If strFolder "." And strFolder ".." Then If GetAttr(strPath & strFolder) And vbDirectory Then n = n + 1 ReDim Preserve a(n) a(n) = strPath & strFolder & "\" lblState.Caption = strPath & strFolder & "\" End If End If strFolder = Dir DoEvents Loop For i = 1 To n SearchFile (a(i)) Next i End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) Application.Visible = True Application.DisplayAlerts = True Application.ScreenUpdating = True Dim wb As Workbook, flag As Boolean flag = False '假定无其它工作薄 For Each wb In Application.Workbooks If wb.Name ThisWorkbook.Name Then flag = True '有其它工作薄 End If Next If flag = False Then '仅本工作蔳，直接退出excel 'Application.Quit End If End Sub |
【本文地址】
今日新闻 |
推荐新闻 |